home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 49
/
Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso
/
-websites-
/
wirenet
/
files
/
thor26_inet.lha
/
rexx
/
Local2Email.br
< prev
next >
Wrap
Text File
|
1999-02-28
|
11KB
|
349 lines
/*
** $VER: Local2Email.br 1.58 (24.2.99)
** by Eirik Nicolai Synnes
**
** Based on ML2Email.thor by Remco van Hooff
**
** See SortMail.guide for documentation
**
*/
options results
parse arg arguments
/*
** Initialize some variables
*/
template = 'SYSTEM/A'
fromthor = 0; cfgread = 0
EVE_ENTERMSG = 0 /* Enter message */
EVE_REPLYMSG = 1 /* Reply message */
EVE_FORWARDMSG = 9 /* Forward message (only for TCP/SOUP) */
EDB_DELETED = 0 /* Event is deleted */
EDB_PACKED = 1 /* Event is packed */
EDB_DONE = 2 /* Event is done */
EDB_ERROR = 3 /* Error performing this event */
EDB_UNRECOVERABLE = 4 /* Event can not be undeleted */
EDB_FREEZE = 5 /* Event is frozen. Will not be done as long as this flag is set. */
CDB_MAIL = 1 /* Private mail conference. */
CDB_NOT_ON_BBS = 15 /* This conference is not on the bbs. */
CDNT_MAILFOLDER = 3 /* This conference is a mail folder. */
UDB_DELETED = 0 /* User is deleted */
UDB_UNRECOVERABLE = 1 /* User can not be undeleted */
BDB_EVENTS_CHANGED = 5 /* Events changed after last event package was made. */
/*
** Find/open Thor ARexx port
*/
/* See if I'm run from Thor */
if left(address(), 5) = 'THOR.' then do
thorport = address()
address(thorport)
'CURRENTSYSTEM STEM 'cursys
if rc ~= 0 then do
say 'CURRENTSYSTEM: 'THOR.LASTERROR
exit(rc)
end
else fromthor = 1
end
/*
** Find/open BBSREAD ARexx port
*/
if ~show('P', 'BBSREAD') then do
address(command)
'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
if exists('SYS:RexxC/WaitForPort') then 'SYS:RexxC/WaitForPort BBSREAD'
else 'WaitForPort BBSREAD'
if (rc = 5) then do; myerr = 'Couldn''t open BBSREAD''s ARexx port.'; rc = 30; signal error; end
if (rc ~= 0) then do; myerr = 'Could not find SYS:Rexxc/WaitForPort.'; rc = 30; signal error; end
end
/*
** Parse arguments
*/
address(bbsread)
if ~fromthor then do
if arguments = '?' | arguments = '' then do
say 'Usage: 'template
exit(0)
end
'READARGS 'template args' CMDLINE 'arguments
if rc ~= 0 then do
say 'READARGS: 'BBSREAD.LASTERROR
exit(rc)
end
cursys.BBSNAME = args.SYSTEM
end
/*
** Get system info
*/
'GETBBSDATA BBSNAME "'cursys.BBSNAME'" STEM 'bbsdata
if rc ~= 0 then do
say 'GETBBSDATA: 'BBSREAD.LASTERROR
exit(rc)
end
if (right(bbsdata.BBSPATH, 1) ~= ':') & (right(bbsdata.BBSPATH, 1) ~= '/') then bbsdata.BBSPATH = bbsdata.BBSPATH || '/'
/*
** Leave if there are no active changed events
*/
if (bbsdata.NUMEVENTS = 0) | ~bittst(bbsdata.FLAGS, BDB_EVENTS_CHANGED) then exit(0)
/*
** Find name of email conference
*/
'GETCONFLIST BBSNAME "'cursys.BBSNAME'" STEM 'conflist
if rc ~= 0 then do
say 'GETCONFLIST: 'BBSREAD.LASTERROR
exit(rc)
end
mailcount = 0
do i = 1 to conflist.COUNT
'GETCONFDATA "'cursys.BBSNAME'" "'addasterix(conflist.i)'" 'confdata
if rc ~= 0 then do
say 'GETCONFDATA: 'BBSREAD.LASTERROR
exit(rc)
end
if bittst(confdata.FLAGS, CDB_MAIL) then do
email = confdata.NAME; mailcount = mailcount + 1
end
end
if symbol('email') ~= 'VAR' then do
say 'Couldn''t find Email conference'
exit(20)
end
if mailcount > 1 then email = readcfg(1)
/*
** Main loop
*/
do n = bbsdata.FIRSTEVENT to bbsdata.LASTEVENT
drop eventtags. eventdata.
changed = 0; crosspost = 0
/* Read event data */
'READBREVENT "'cursys.BBSNAME'" EVENTNR 'n' DATASTEM 'eventdata' TAGSSTEM 'eventtags
if rc ~= 0 then do
say 'READBREVENT: 'BBSREAD.LASTERROR
exit(rc)
end
/* Skip event if it is not a reply/enter or it is deleted, packed, etc. */
if ~(eventdata.EVENTTYPE = EVE_ENTERMSG | eventdata.EVENTTYPE = EVE_REPLYMSG | eventdata.EVENTTYPE = EVE_FORWARDMSG) then iterate n
if bittst(eventdata.FLAGS, EDB_DELETED) | bittst(eventdata.FLAGS, EDB_PACKED) | bittst(eventdata.FLAGS, EDB_DONE) | bittst(eventdata.FLAGS, EDB_ERROR) | bittst(eventdata.FLAGS, EDB_UNRECOVERABLE) | bittst(eventdata.FLAGS, EDB_FREEZE) then iterate n
/* Split conferences and to-addresses into stems */
if index(eventtags.CONFERENCE, ',') > 0 then do
crosspost = 1; confs = eventtags.CONFERENCE; ccnt = 0
do while index(confs, ',') > 0
ccnt = ccnt + 1; confs.ccnt = left(confs, (index(confs, ',') - 1))
confs = substr(confs, index(confs, ',') + 1)
end
ccnt = ccnt + 1; confs.ccnt = confs; confs.count = ccnt; drop confs ccnt
end
else do; confs.count = 1; confs.1 = eventtags.CONFERENCE; end
if index(eventtags.TOADDR, ',') > 0 then do
toaddrs = eventtags.TOADDR; acnt = 0
do while index(toaddrs, ',') > 0
acnt = acnt + 1; toaddrs.acnt = left(toaddrs, (index(toaddrs, ',') - 1))
toaddrs = substr(toaddrs, index(toaddrs, ',') + 1)
end
acnt = acnt + 1; toaddrs.acnt = toaddrs; toaddrs.count = acnt; drop toaddrs acnt
end
else do; toaddrs.count = 1; toaddrs.1 = eventtags.TOADDR; end
/* Replace local conferences with email conference and add reply address */
do i = 1 to confs.count
drop confdata.; unknown = 0
'GETCONFDATA "'cursys.BBSNAME'" "'addasterix(confs.i)'" 'confdata
if rc ~= 0 then do
if BBSREAD.LASTERROR = 'Unknown conference' then unknown = 1
else do
say 'GETCONFDATA: 'BBSREAD.LASTERROR
exit(rc)
end
end
if ~(unknown) & (confdata.CONFNETTYPE = CDNT_MAILFOLDER) then do
if cfgread = 0 then call readcfg(0);
addradd = 0
if trig.count > 0 then do m = 1 to trig.count
if upper(trig.m.conf) = upper(confs.i) then do
match = 0
do j = 1 to toaddrs.count
if upper(toaddrs.j) = upper(trig.m.addr) then match = 1
end
if ~(match) then do
say trig.m.addr
acnt = toaddrs.count + 1; toaddrs.acnt = trig.m.addr; toaddrs.count = acnt;
addradd = 1
end
end
end
if (addradd = 1 & confs.i ~= email) then confs.i = email
changed = 1
end
end
/* Recreate conference and to-address strings */
eventtags.CONFERENCE = ''; mailfound = 0
do i = 1 to confs.count
if (upper(confs.i) ~= upper(email)) | (~mailfound) then eventtags.CONFERENCE = eventtags.CONFERENCE || confs.i || ','
if (~mailfound) & (upper(confs.i) = upper(email)) then mailfound = 1
end
eventtags.CONFERENCE = strip(eventtags.CONFERENCE, 'B', ',')
eventtags.TOADDR = ''
do i = 1 to toaddrs.count
eventtags.TOADDR = eventtags.TOADDR || toaddrs.i || ','
end
eventtags.TOADDR = strip(eventtags.TOADDR, 'B', ',')
/* Replace names with corresponding address(es) */
if (~crosspost) & (symbol('eventtags.TOADDR') = 'VAR') & (strip(eventtags.TOADDR, 'B') ~= '') & (length(eventtags.TOADDR) = length(compress(eventtags.TOADDR, '@#?*()|'))) then do
drop user.
'SEARCHBRUSER "'cursys.BBSNAME'" STEM 'user' SEARCH "'addasterix(eventtags.TOADDR)'" NAME'
if rc ~= 0 then do
say 'SEARCHBRUSER: 'BBSREAD.LASTERROR
exit(rc)
end
if result > 0 then do
drop usertags. userdata.
'READBRUSER BBSNAME "'cursys.BBSNAME'" USERNR 'user.1.USERNR' TAGSSTEM 'usertags' DATASTEM 'userdata
if rc ~= 0 then do
say 'READBRUSER: 'BBSREAD.LASTERROR
exit(rc)
end
if ~bittst(userdata.FLAGS, UDB_DELETED) & ~bittst(userdata.FLAGS, UDB_UNRECOVERABLE) then do
eventtags.TOADDR = usertags.ADDRESS; changed = 1
end
end
end
if changed then do
'WRITEBREVENT BBSNAME "'cursys.BBSNAME'" EVENT 'eventdata.EVENTTYPE' STEM 'eventtags 'UPDATEEVENTNR 'n
if rc ~= 0 then do
say 'READBRUSER: 'BBSREAD.LASTERROR
exit(rc)
end
end
end
exit(0)
/*
** Procedures
*/
readcfg: procedure expose cfgread trig. bbsdata.
parse arg email
foundcfg = 0; trigcnt = 0
cfgpath = bbsdata.BBSPATH
cfgfile = 'SortMail.cfg'
if (right(cfgpath, 1) ~= '/') & (right(cfgpath, 1) ~= ':') then cfgpath = cfgpath || '/'
if ~exists(cfgpath || cfgfile) then do
say 'Couldn''t find SortMail.cfg'
exit(30)
end
cfgopen = open(cf, cfgpath || cfgfile, 'R')
address(bbsread)
if cfgopen then do until eof(cf)
entry = readln(cf)
if ~email & upper(subword(entry, 1, 1)) = 'ACTION' then do
'READARGS TEMPLATE "TYPE/A,DESTSYS/K,DESTCONF/K,REPLYADDR/K,SCRIPTNAME/K,SCRIPTOPTS/K,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S,CHECKDUPES/S,DONTADD/S,NOSTATS/S,SUBJECT/K,SENDTO/K,TEXTFILE/K" STEM 'trigentry' CMDLINE 'subword(entry, 2)
if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
if (upper(trigentry.TYPE) = 'COPY' | upper(trigentry.TYPE) = 'MOVE' | upper(trigentry.TYPE) = 'SPLITDIGEST') & symbol('trigentry.REPLYADDR') = 'VAR' then do
trigcnt = trigcnt + 1; trig.trigcnt.conf = trigentry.DESTCONF; trig.trigcnt.addr = trigentry.REPLYADDR
end
trig.count = trigcnt; drop trigentry.
end
if email & upper(subword(entry, 1, 1)) = 'GLOBAL' then do
'READARGS TEMPLATE "SYSTEM/K,CONFERENCE/A,STATISTICS/S,NOWARN/S,LOGINSTATE/S" STEM 'trigentry' CMDLINE 'subword(entry, 2)
if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
call close(cf)
return(trigentry.CONFERENCE)
end
end
cfgread = 1
call close(cf)
return(0)
addasterix: interpret 'procedure expose 'globals
parse arg str
if str = '' then return(str)
lastfound = 0; found = index(str, '*')
do while found > lastfound
secondpart = substr(str, found + length('*'))
firstpart = substr(str, 1, length(str) - length(substr(str, found)))
str = firstpart || '**' || secondpart
lastfound = found + length('**')
found = index(str, '*', lastfound)
end
lastfound = 0; found = index(str, '"')
do while found > lastfound
secondpart = substr(str, found + length('"'))
firstpart = substr(str, 1, length(str) - length(substr(str, found)))
str = firstpart || '*"' || secondpart
lastfound = found + length('*"')
found = index(str, '"', lastfound)
end
lastfound = 0; found = index(str, '=')
do while found > lastfound
secondpart = substr(str, found + length('='))
firstpart = substr(str, 1, length(str) - length(substr(str, found)))
str = firstpart || '*=' || secondpart
lastfound = found + length('*=')
found = index(str, '*', lastfound)
end
return(str)